home *** CD-ROM | disk | FTP | other *** search
/ Into That Dark Night / Into That Dark Night.iso / pc / YadVashem / Database / WorkDir / ICONtml.PL < prev    next >
Encoding:
Text File  |  1999-01-20  |  16.8 KB  |  457 lines
  1. # Parsing The Timeline files of and finding keywords etc.
  2. # Written: Eli Zvuluny - 
  3. #  Possible Worlds
  4. #
  5. # First version - 17/1/99
  6. #
  7. #
  8. # The lex values is taken from the file lexItems.txt generated by access.
  9.  
  10. #  require 'StandardFile.pl';
  11.  
  12. # First start to process all files in the current folder for an existance of
  13. # keywords (i.e. for a lexicon entries)
  14.  
  15.    use Cwd;
  16.    use English;
  17.    
  18.    
  19.    $keyFile = "lexItems.txt";    # file name generated by access, in the directory "workDir"
  20.    open (ERRFILE, ">keyErr.lex");
  21.    print "==== Processing the keywords (lexItems.txt) file =====\n";
  22.    open (KEYFILE, "<$keyFile") or die "can't open file $keyFile\n";
  23.    while (<KEYFILE>) {
  24.       $current_line = $_;
  25.       chomp;
  26.       ($tmpNum, $tmpKey) = $current_line =~ /^(\d+),(.+)$/;
  27.       $tmpKey =~ tr/a-z/A-Z/;
  28.       # in case of multi words, extract extra blanks
  29.       @tmpArr = split(/\s+/,$tmpKey);
  30.       $tmpKey = join(" ",@tmpArr);
  31. #      print "Before Keys $tmpKey\n";
  32.       ($tmpKey, $parenKey) = $tmpKey =~ /^([^\(\)]+[^\s])\s*(\([^\(\)].*\))*\s*$/;
  33. #      print "Keys $tmpKey, $parenKey\n";
  34.       chop($tmpKey) if $tmpKey =~ /[\,\.\:]$/;  # extract possible extra characters
  35.       if ($lexItems{$tmpKey}) {
  36.          print "*** The lexicon item: [$tmpKey] already exists\n";
  37.          print ERRFILE "*** The lexicon item: [$tmpKey] already exists\n";
  38.  
  39.       } else {
  40.         $lexItems{$tmpKey} = $tmpNum;
  41.         $lexNums{$tmpNum} = $tmpKey;  # and the inverted list
  42.       }
  43.       if ($parenKey) {
  44.          $parenKey =~ s/\((.*)\)/\1/;
  45.          chop($parenKey) if $parenKey =~ /[\,\.\:]$/;  # extract possible extra characters
  46.          if ($lexItems{$parenKey}) {
  47.             print "*** The lexicon item: [$parenKey] already exists\n";
  48.             print ERRFILE "*** The lexicon item: [$parenKey] already exists\n";
  49.  
  50.          } else {
  51.            $lexItems{$parenKey} = $tmpNum;
  52.            $lexNums{$tmpNum} = $tmpKey;  # and the inverted list
  53.          }
  54.       }
  55.    } # while KEYFILE
  56.    close (KEYFILE);
  57.    foreach  $key (sort (keys (%lexItems))) {
  58.      print "$key $lexItems{$key}\n";
  59.     # check if there is a paired keywords separated with a ","
  60.      if ($key =~ /^([^\,]+)\s*\,\s*([^\,\(\)]+)(\s*\(.*\))*$/) {
  61. #       print "paired - $1 - $2 $key, $lexItems{$key}\n";
  62.         $pairedItems{$1} = $2;
  63.         $pairedItems{$2} = $1;
  64.         $pairLexKey{$1 . " " . $2} = $lexItems{$key};
  65.         $pairLexKey{$2 . " " . $1} = $lexItems{$key};
  66. #       print "paired - $1 - $2 $key, $lexItems{$key}\n";
  67.         if (!$lexItems{$1}) { # the If enforce the existance of a normal entry which = first part of pair
  68.            $lexItems{$1} = $lexItems{$key};  # this will be the last choice for a pair element.
  69. #           $lexNums{$idx-1} = $1;
  70.         }
  71.         $firstPaired{$lexItems{$key}} = $1;  # used for a case of multipled paired entries (such as
  72.         # (Kaplan, Moshe - Kaplan, Shimon), in those cases, on the second entry (Shimon), when
  73.         # there is a simple reference to Kaplan (a lot), the system mark it by mistake since
  74.         # it assumes that it refers to the first Kaplan, and not to the titled keyword.
  75.      }
  76.      else { #if it is a multiword, save the first word, and max number of words for that item. 
  77.          @tmpArr = split(/\s+/,$key);
  78.          if ($#tmpArr > 1) {
  79.             $tmpVal =  $firstWord{$tmpArr[0]};
  80.             if ($#tmpArr > $tmpVal) {
  81.                $firstWord{$tmpArr[0]} = $#tmpArr+1;
  82.             }
  83. #            print " Multiword $Key, $tmpArr[0], $firstWord{$tmpArr[0]}\n";
  84.          } 
  85.      } #if - elsif
  86.      if (($beforeParen, $inParen) = $key =~ /^\s*([^\s]+)\s*\((.+)\s*\)$/) {
  87.          chop($beforeParen) if $beforeParen =~ /[\,\.\:]$/;  # extract possible extra characters
  88.          chop($inParen) if $inParen =~ /[\,\.\:]$/;  # extract possible extra characters
  89.         if (!$lexItems{$inParen}) {
  90.            $lexItems{$inParen} = $lexItems{$key};
  91.         }
  92.         if (!$lexItems{$beforeParen}) {
  93.            $lexItems{$beforeParen} = $lexItems{$key};
  94.         }
  95.      }  # there is another keyword in Parentheses
  96.    } #foreach
  97.    $dirname = "lexFiles";
  98.    $currentDir = cwd;
  99. #   print "$currentDir \n";
  100. #   printKeyArr (\%pairLexKey);
  101.    # now get the base dir, which is the parent directory, and the directory separator
  102.    ($dirSep,$lastDir) = $currentDir =~ /([\\\:])([^\\\:]+)$/;
  103. #   $baseDir =  $`;
  104.    $baseDir =  $PREMATCH;
  105.    @dirVec = ("TLtext");
  106.    foreach $theDir (@dirVec) {  
  107.       $dirname = "$baseDir$dirSep" . "Text" . "$dirSep$theDir";
  108.       mkdir ("${dirname}1", umask());
  109.        opendir(CURDIR, $dirname)  or die "can't open $dirname\n";
  110.           chdir($dirname);
  111.  
  112.        $lastKey = "";
  113.        $oneLinerName = "oneLiner.txt";
  114.        open (ONELINER, ">${dirname}1$dirSep$oneLinerName");
  115.        print "==== Start processing the Timeline files in $theDir =====\n";
  116.        while ($curFile = readdir(CURDIR)) {
  117.           if ($curFile =~ /tl(\d\d\d\d\d\d).doc/i) {
  118.             $evDate = $1;
  119.             print "-----$curFile----\n";
  120.             $veryBigLine = "";
  121.             open (FILEIN, "<$curFile") or die "can't open file\n";
  122.              open (TXTFILE, ">${dirname}1$dirSep$curFile");
  123.              $oneLineMode = 1;
  124.              $firstPartLine = "";
  125.             while  (<FILEIN>) {
  126.               $current_line = $_;
  127.               if ($oneLineMode) {
  128.                  chomp $current_line;
  129.                  if ($current_line =~ /\@\@\@/) {
  130.                     $oneLineMode = 0;
  131.                     print ONELINER "$evDate\|$firstPartLine\n";
  132.                  } else {
  133.                    $firstPartLine .= $current_line;
  134.                  }
  135.               } else {
  136.                    $veryBigLine = $veryBigLine . $current_line;
  137.               } #if onlinemode
  138.             } # while
  139.             # extract key number from file name
  140.             ($fileIdx) = $curFile =~ /txt(\d+)\.doc/i;
  141.             # set the value of lastKey, which is the key associated with the file.
  142.             $lastKey = $lexNums{$fileIdx};
  143. #            print "Last key is $lastKey\n";
  144.             if (!$lastKey) {
  145.                $lastKey = "stamstamstam";
  146.             }
  147.              &closeKeyItem($lastKey);  # handle last keyword
  148.             
  149.             close (FILEIN);
  150.           } #if
  151.        } # while
  152.    } # foreach @dirVec
  153.    close (KEYFILE);
  154.    close (ERRFILE);
  155.    close (ONELINER);
  156.    print "==== Successful processing =====\n";
  157.    
  158.  
  159. sub closeKeyItem
  160. {
  161.     local($curKey) = @_;
  162.     if ($curKey eq "") {
  163. #       print "Nothing to do now (really) !!!!!\n";
  164.     } else {
  165.     $veryBigLine =~ s/\n/ # /g;
  166.     # now replace all the Bold and Italic with @b and @i.
  167.       while (($HtmlTag,$innerString) = $veryBigLine =~ /<([IB])>([^[<>]*)<\/\1>/i) {
  168.          # found, replace all the internal words with @i@ or @b@
  169.          $beforeStr = $PREMATCH;
  170.          $afterStr = $POSTMATCH;
  171.          @markedWords = split(/\s+/,$innerString);
  172. #         print " $HtmlTag,$innerString Number is $#markedWords\n";
  173.          if ($#markedWords >= 0) {
  174.             for ($i = 0; $i <= $#markedWords; $i++) {
  175.                if ($markedWords [$i] !~ /^\s*$/) {
  176. #                  print "$markedWords[$i]\n";
  177.                   if ($markedWords [$i] ne "#") {
  178.                      $markedWords [$i] = '@' . $HtmlTag . '@' . $markedWords [$i];
  179.                   } 
  180.                }
  181.             } # for
  182.          } # if there is something between tag and its closure
  183.          $veryBigLine = $beforeStr . " " . join(" ",@markedWords) . " " . $afterStr;
  184.       } # while
  185.       &handleLines($lastKey, $veryBigLine);
  186.       
  187.       $veryBigLine = join (" ",@splitWords);
  188.       $veryBigLine =~ s/\s*\007\s*/\007/g;
  189.       $veryBigLine =~ s/\007/\n/g;
  190.       print TXTFILE $veryBigLine;
  191.       $veryBigLine = "";
  192.       close (TXTFILE);
  193.     }
  194. } # closeKeyItem
  195.  
  196. sub handleLines
  197. {
  198.     local($curKey, $theLine) = @_;
  199.     my $i, $tmpWord;
  200.     
  201.     # first replace the new line with another symbol
  202.     $theLine =~ s/\n/\007/g;
  203.     @splitWords = split(/\s+/,$theLine);
  204.     # The algorithm for finding if a keyword already exist:
  205.     # First of all naturally translate all words into uppercase characters.
  206.     # The priorities for a keyword is:
  207.     # 1. Key word that contains couple of words.
  208.     # 2. Key words that compose of 2 parts weparated by ",". <part1>,<part2>
  209.     #    The possible combinations are: <part1> <part2> | <part2> <part1> | <part1>
  210.     # 3. Single word that did not fulfill any of the previous criterias
  211.     #
  212.     # on All cases, we may try to use the canonic version of the word.
  213.     # in all cases we do not look for the current file keyword.
  214.     $prevWords = "";
  215.     $numOfWords = 0;
  216. #    print "split words $#splitWords\n";
  217.     for ($i = 0; $i <= $#splitWords; $i++) { 
  218.        $tmpWord = $splitWords[$i];
  219.        $tmpWord =~ tr/a-z/A-Z/;
  220.        $tmpWord =~ s/^\@[IB]\@(.*)$/\1/i;
  221. #       if ($tmpWord =~ /^<[\/]?b>/i) {
  222. #          print "$tmpWord\n";
  223. #       }
  224. #       $tmpWord =~ s/^<[\/]?b>(.+)<[\/]?b>$/\1/i;
  225.        # as said let's first check if the keyword is part of a multiword item
  226.        # fast seach for firstword existance:
  227.        if ($keyLength = $firstWord{$tmpWord}) {
  228.           if (&checkManyWords($keyLength, $i)) {
  229. #             print "Succesful match of multi words\n";
  230.              $i += $keyLength-1;  # skip all matched words ($i was already incremented by 1)
  231.           } 
  232.        } # if there is a chance for a multiword key.
  233.        elsif ($keyLength = &checkPairedWords($i)) { # now look of a paired keywords
  234. #             print "Succesful match of paired words\n";
  235.              $i += $keyLength-1;  # skip all matched words
  236.        } elsif ($keyLength = &checkOne($i)) {
  237. #            print "Succesful match of Single words\n";
  238.             # no need to skip all matched words
  239.        } else {
  240.             &checkPluralEtc($i);
  241.        }
  242. #        $scanKey = ($prevWords ne "") ? $prevWords . " " . $tmpWord : $tmpWord;
  243. #        if ($lexItems{$scanKey} &&  $scanKey ne $curKey) {  
  244. #           print " Word found: $scanKey, in text -- $curKey\n";
  245. #           @keyWord = split(/\s+/,$scanKey);
  246. #           if ($#keyWord > 1) {
  247. #              print " good results found it\n";
  248. #              $prevWords = "";
  249. #              $numOfWords = 0;
  250. #          } # keywords has more than 1 word
  251. #        } #found exactly as appreas in master keywords 
  252. #        elsif ($firstWord{$tmpWord} < 2) { 
  253. #              $prevWords = "";
  254. #              $numOfWords = 0;
  255. #        }
  256. #        else {
  257. #              $prevWords = $prevWords . " " . $tmpWord;
  258. #              $numOfWords++;
  259. #              print " a long prev word found --- $prevWords -- $numOfWords\n";
  260. #           
  261. #        } # 
  262.     } # for
  263. }
  264.  
  265. sub checkManyWords
  266. {
  267.     local ($numOfWords, $curIndex) = @_;
  268.     my $tmpIdx, $tmpStr;
  269.     my $i;
  270.     $tmpIdx = $curIndex + $numOfWords; 
  271.     $tmpStr = $splitWords[$curIndex];
  272.     for ($i = 1; $i < $numOfWords; $i++) {
  273.       # concatenate the next $numOfWords into one keyword
  274.       $tmpStr = $tmpStr . " " . $splitWords[$curIndex+$i];
  275.     } # for
  276.     $tmpStr =~ tr/a-z/A-Z/;
  277.     $tmpStr =~ s/\@[IB]\@([^\@]*)/\1/ig;
  278.     chop($tmpStr) if $tmpStr =~ /[\,\.\:]$/;
  279.     chop($tmpStr) if $tmpStr =~ /\)$/;
  280.     if ($tmpStr =~ /^\(/) {
  281.        $tmpStr = substr ($tmpStr, 1);
  282.     }
  283.     if ($tmpStr =~ /^(.*)\'s$/i) {
  284.        $tmpStr = $1;
  285.     }
  286.     $theIndex = $lexItems{$tmpStr};
  287. #    print " Value of index $lexItems{$tmpStr}\n" if $theIndex;
  288.     if ($theIndex && (($theDir ne "Lexicon") || ($theIndex != $fileIdx))) {
  289. #       for ($i = 0; $i < $numOfWords; $i++) {
  290. #          $splitWords[$curIndex+$i] =~ s/^/\@$theIndex\@/;
  291. #          print "$splitWords[$curIndex+$i] ";
  292.    # This was the old method
  293.     #   $splitWords[$curIndex] =~ s/^/\<$theIndex\>/;
  294.     #   $splitWords[$curIndex + $numOfWords-1] =~ s/$/\<\/$theIndex\>/;
  295. #        print "Added tag in checkManyWords - $splitWords[$curIndex]\n";
  296.         for ($i = $curIndex; $i < $curIndex+$numOfWords ; $i++) {
  297.            $splitWords[$i] =~ s/^/\@\+$theIndex\@/;
  298.         }
  299. #       } # for
  300. #       print "\n";
  301.        
  302.     }
  303.     $retVal = $lexItems{$tmpStr};
  304. } # checkManyWords
  305.  
  306.  
  307. sub checkPairedWords
  308. {
  309.     local ($curIndex) = @_;
  310.     my $tmpStr, $secondPair;
  311.     
  312.     $tmpStr = $splitWords[$curIndex];
  313.     $tmpStr =~ tr/a-z/A-Z/;
  314.     $tmpStr =~ s/\@[IB]\@([^\@]*)/\1/ig;
  315.     if ($secondPair = $pairedItems{$tmpStr}) {
  316. #        print "=-=-=-= $secondPair = $splitWords[$curIndex]  =-= $tmpStr\n";
  317.         @tmpArr = split(/\s+/,$secondPair);
  318.         $arrLen = $#tmpArr ? $#tmpArr : 1;
  319.        if (&checkManyPair($arrLen+1, $curIndex)) {
  320. #             print "!!!!Succesful match of First Paired words\n";
  321.              $retVal = $arrLen+1;
  322.        } else {
  323.              $retVal = 0;
  324.        }
  325.     } else {
  326.         $retVal = 0;
  327.     }
  328. }
  329.  
  330. sub checkManyPair
  331. {
  332.     local ($numOfWords, $curIndex) = @_;
  333.     my $tmpIdx, $tmpStr;
  334.     my $i;
  335.     $tmpIdx = $curIndex + $numOfWords; 
  336.     $tmpStr = $splitWords[$curIndex];
  337.     for ($i = 1; $i < $numOfWords; $i++) {
  338.       # concatenate the next $numOfWords into one keyword
  339.       $tmpStr = $tmpStr . " " . $splitWords[$curIndex+$i];
  340.     } # for
  341. #    print " in CheckManyPair $tmpStr\n";
  342.     $tmpStr =~ tr/a-z/A-Z/;
  343.     $tmpStr =~ s/\@[IB]\@([^\@]*)/\1/ig;
  344. #    print " after CheckManyPair $tmpStr\n";
  345.     chop($tmpStr) if $tmpStr =~ /[\,\.\:]$/;
  346.     chop($tmpStr) if $tmpStr =~ /\)$/;
  347.     if ($tmpStr =~ /^\(/) {
  348.        $tmpStr = substr ($tmpStr, 1);
  349.     }
  350.     if ($tmpStr =~ /^(.*)\'s$/i) {
  351.        $tmpStr = $1;
  352.     }
  353.     $theIndex = $pairLexKey{$tmpStr};
  354. #    print " after CheckManyPair the Index $theIndex,$tmpStr\n";
  355. #    print " Value of index (in pair) $pairLexKey{$tmpStr}\n" if $theIndex;
  356.     if ($theIndex && (($theDir ne "Lexicon") || ($theIndex != $fileIdx))) {
  357. #       for ($i = 0; $i < $numOfWords; $i++) {
  358. #          $splitWords[$curIndex+$i] =~ s/^/\@$theIndex\@/;
  359.    # This was the old method
  360.    #    $splitWords[$curIndex] =~ s/^/\<$theIndex\>/;
  361.    #    $splitWords[$curIndex + $numOfWords-1] =~ s/$/\<\/$theIndex\>/;
  362.         for ($i = $curIndex; $i < $curIndex+$numOfWords ; $i++) {
  363.            $splitWords[$i] =~ s/^/\@\+$theIndex\@/;
  364.         }
  365. #        print "Added tag in checkManyPairs - $splitWords[$curIndex]\n";
  366. #          print "$splitWords[$curIndex+$i] ";
  367. #       } # for
  368. #       print "\n";
  369.        
  370.     }
  371.     $retVal = $theIndex;
  372. } # checkManyPair
  373.  
  374. sub checkOne
  375. {
  376.     local ($curIndex) = @_;
  377.      my $tmpStr;
  378.     
  379.     $tmpStr = $splitWords[$curIndex];
  380.     $tmpStr =~ tr/a-z/A-Z/;
  381.     $tmpStr =~ s/\@[IB]\@([^\@]*)/\1/ig;
  382.     chop($tmpStr) if $tmpStr =~ /[\,\.\:]$/;
  383.     chop($tmpStr) if $tmpStr =~ /\)$/;
  384.     if ($tmpStr =~ /^\(/) {
  385.        $tmpStr = substr ($tmpStr, 1);
  386.     }
  387.     if ($tmpStr =~ /^(.*)\'S$/) {
  388.        $tmpStr = $1;
  389.     }
  390.     
  391.     $theIndex = $lexItems{$tmpStr};
  392. #    print " Value of index $lexItems{$tmpStr}\n" if $theIndex;
  393. #    if ($theIndex && $firstPaired{$fileIdx} =~ /\b$tmpStr\b/) {
  394. #       print " match first pair in file $fileIdx, entry $tmpStr - $firstPaired{$fileIdx}\n";
  395. #    }
  396.     if ($theIndex &&  (($theDir ne "Lexicon") || ($theIndex != $fileIdx)) && ($firstPaired{$fileIdx} !~ /\b$tmpStr\b/)) {
  397. #       $splitWords[$curIndex] =~ s/^/\@$theIndex\@/;
  398.    # This was the old method
  399.    #    $splitWords[$curIndex] =~ s/^(.*)$/\<$theIndex\>\1\<\/$theIndex\>/;       
  400.            $splitWords[$curIndex] =~ s/^/\@\+$theIndex\@/;
  401. #        print "Added tag in checkOne - $splitWords[$curIndex]\n";
  402. #       print "$splitWords[$curIndex]\n ";
  403.        $retVal = 1;
  404.     } else {
  405.        $retVal = 0;
  406.     }
  407. } # checkOne
  408.  
  409. sub checkPluralEtc
  410. {
  411.     local ($curIndex) = @_;
  412.      my $tmpStr;
  413.  
  414.     $tmpStr = $splitWords[$curIndex];
  415.     $tmpStr =~ tr/a-z/A-Z/;
  416.     $tmpStr =~ s/\@[IB]\@([^\@]*)/\1/ig;
  417.     chop($tmpStr) if $tmpStr =~ /[\,\.\:]$/;
  418.     chop($tmpStr) if $tmpStr =~ /\)$/;
  419.     if ($tmpStr =~ /^\(/) {
  420.        $tmpStr = substr ($tmpStr, 1);
  421.     }
  422.     if ($tmpStr =~ /^(.*)\'S$/) {
  423.        $tmpStr = $1;
  424.     } elsif ($tmpStr =~ /^(.*)IES$/) {
  425.        $tmpStr = $1 . "Y";
  426.     } elsif ($tmpStr =~ /^(.*)ES$/) {
  427.        $tmpStr = $1;
  428.     } elsif ($tmpStr =~ /S$/) {   # regular plural
  429.        chop($tmpStr);
  430.     } else {
  431.        return 0;
  432.     }
  433.        
  434.     
  435.     $theIndex = $lexItems{$tmpStr};
  436. #    print " Value of index(Plural) $lexItems{$tmpStr}\n" if $theIndex;
  437.     if ($theIndex && (($theDir ne "Lexicon") || ($theIndex != $fileIdx))  && ($firstPaired{$fileIdx} !~ /\b$tmpStr\b/)) {
  438.    # This was the old method
  439.     #   $splitWords[$curIndex] =~ s/^(.*)$/\<$theIndex\>\1\<\/$theIndex\>/;
  440.            $splitWords[$curIndex] =~ s/^/\@\+$theIndex\@/;
  441. #        print "Added tag in checkPlural Etc. - $splitWords[$curIndex]\n";
  442. #       $splitWords[$curIndex] =~ s/^/\@$theIndex\@/;
  443. #       print "(Plural) $splitWords[$curIndex]\n ";
  444.        $retVal = 1;
  445.     } else {
  446.        $retVal = 0;
  447.     }
  448. } # checkPluralEtc
  449.  
  450. sub printKeyArr
  451. {
  452.    local($arRef) = @_;
  453.    foreach $key (keys (%$arRef)) {
  454.       print " The Key $key and its val $$arRef{$key}\n";
  455.    }
  456. }   
  457.